home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / dev / basic / HB2Gads.lha / HB2Gads / WGads.bas < prev    next >
BASIC Source File  |  1980-03-28  |  47KB  |  1,710 lines
  1. 'GADTOOLS/GADGETS
  2. 'Benito Lombardi 1997
  3. ''''''''''''''''''
  4. 'COMPILER SETTINGS
  5. ''''''''''''''''''
  6. REM $DYNAMIC
  7. REM $NOWINDOW
  8. REM $NOLIBRARY
  9. REM $NOBREAK
  10. REM $NOEVENT
  11. REM $NOOVERFLOW
  12. REM $NOVARCHECKS
  13. REM $AUTODIM
  14. REM $UNDERLINES
  15. REM $NOADDICON
  16. REM $ARRAY
  17. REM $STACK
  18. REM $JUMPS
  19. REM $OPTION k 150
  20. ''''''''''
  21. DEFINT a-z
  22. '''''''''''''''
  23. 'INCLUDE FILES'
  24. '''''''''''''''
  25. 'REM $include intuition.bh
  26. 'REM $include gadtools.bh
  27. 'REM $include graphics.bh
  28. 'REM $include exec.bh
  29. 'REM $include Blib/ExecSupport.bas
  30. 'REM $include utility.bh
  31. '''''''''''
  32. 'LIBRARIES'
  33. '''''''''''
  34. LIBRARY "dos.library"
  35.  DECLARE FUNCTION xClose& LIBRARY
  36.  DECLARE FUNCTION Execute& LIBRARY
  37.  DECLARE FUNCTION xOpen& LIBRARY
  38. LIBRARY OPEN "exec.library"
  39. LIBRARY OPEN "gadtools.library",37
  40. LIBRARY OPEN "graphics.library",37
  41. LIBRARY OPEN "intuition.library",37
  42. nil_handle&= xOpen&(SADD("NIL:"+CHR$(0)),1005&)
  43. ''''''''''''''''''''''''
  44. 'MAIN SCREEN AND WINDOW'
  45. ''''''''''''''''''''''''
  46. SCREEN 1,640,200,2,2
  47. WINDOW 1,,(0,0)-(640,200),16+32+128+256,1
  48. Busy.Pointer
  49. '''''''''''''''''''''''''''''''''''
  50. 'ARRAYS/GADGET VARIABLES/FONT/TAGS'
  51. '''''''''''''''''''''''''''''''''''
  52. CONST BUTTONKIND  = 1
  53. CONST CHECKBOXKIND= 2
  54. CONST INTEGERKIND = 3
  55. CONST LISTVIEWKIND= 4
  56. CONST MXKIND      = 5
  57. CONST NUMBERKIND  = 6
  58. CONST CYCLEKIND   = 7
  59. CONST PALETTEKIND = 8
  60. CONST SCROLLERKIND= 9
  61. CONST SLIDERKIND  = 11
  62. CONST STRINGKIND  = 12
  63. CONST TEXTKIND    = 13
  64. '---------------------
  65. COMMON SHARED act.win&,b.ptr&,gid,rport&
  66. DIM f_gads&(0),m_gads&(16),ng(NewGadget_sizeof\2)
  67. DIM AGadgetTags&(10),GadgetTags&(20),TempTags&(40),ATempTags&(10)
  68. DIM SHARED c(27),label$(0),p(12),parm(14),txt$(14)
  69. '---------------------
  70. myscr&= LockPubScreen&(0&)
  71. IF myscr&= 0 THEN
  72.  Error.Trap 1
  73. ELSE
  74.     TAGLIST VARPTR(TempTags&(0)),TAG_DONE&
  75.     vi&= GetVisualInfoA&(myscr&,VARPTR(TempTags&(0)))
  76.  IF vi&= 0 THEN Error.Trap 2 ELSE POKEL VARPTR(ng(ng_visualInfo\2)),vi&
  77. END IF
  78. '-----
  79. DIM topaz80(4)
  80. Init.TextAttr topaz80(),"topaz.font",8,0,0
  81. font&= OpenFont&(VARPTR(Topaz80(0)))
  82. IF font&= 0 THEN Error.Trap 3
  83. '-----
  84. DIM FboxTags&(20),RboxTags&(20)
  85. TAGLIST VARPTR(FboxTags&(0)),GTBB_FrameType&,1,GT_VisualInfo&,vi&,TAG_DONE&
  86. TAGLIST VARPTR(RboxTags&(0)),GTBB_Recessed&,1,GT_VisualInfo&,vi&,TAG_DONE&
  87. '-----
  88. '
  89. '''''''''
  90. Main.Menu
  91. '''''''''
  92. '
  93. ''''''''''''''''''''
  94. 'PROGRAM SUBROUTINES
  95. ''''''''''''''''''''
  96. SUB About.Text
  97. STATIC i,j
  98. '---------
  99. f_gad&= 0& :f_list&= 0&
  100. f_gad&= CreateContext&(VARPTR(f_list&))
  101. '---------
  102. c(0)= 40 :REDIM txt$(40)
  103. RESTORE About_Text
  104. FOR i= 0 TO 40 :READ txt$(i) :NEXT
  105. Create.ViewList viewlist&,2
  106. RESTORE ListView_About
  107. '---------
  108. FOR i= 0 TO 14 :parm(i)= 0 :NEXT
  109. REDIM label$(0) :REDIM f_gads&(0)
  110. FOR i= 0 TO 8 :READ parm(i) :NEXT :READ label$(0)
  111. Create.Gadgets f_gad&,f_list&,f_gads&()
  112. Gads.Window f_list&,1 :Add2.IDCMPFlags
  113. Process.WindowEvents f_gads&()
  114. '---------
  115. CloseWindow act.win&
  116. FreeGadgets f_list&
  117. Free.ViewList    viewlist&
  118. EXIT SUB
  119. '-------
  120. ListView_About:
  121. DATA 0,6,10,461,152,0,4,0,1,""
  122. '-------
  123. About_Text:
  124. DATA ""
  125. DATA " This program was written using an A2000 and requires"
  126. DATA " an OS2+. It is FREEWARE and can be freely copied and"
  127. DATA " distributed as long as no monetary gain is involved."
  128. DATA " It is also provided  'as is'  without any express or"
  129. DATA " implied guaranty."
  130. DATA ""
  131. DATA "The program appears to be free of bugs.... but if you"
  132. DATA "experience any, please let me know; also, if you make"
  133. DATA "any significant improvement in the code."
  134. DATA ""
  135. DATA "Credits and thanks are expressed to Nico Francois for"
  136. DATA "LacePointer, and to Stieve Tibbet for the code of the"
  137. DATA "Spinning Clock, which are both used in this program."
  138. DATA ""
  139. DATA "My original purpose was to attach GadTools Gadgets to"
  140. DATA "GimmeZeroZero and Borderless Windows, opened with the"
  141. DATA "HBasic2 WINDOW Command as in GADS.bas. My goal though"
  142. DATA "fell quite short, because I was unable for example to"
  143. DATA "implement properly  a ListView Gadget when it was the"
  144. DATA "sole or very first gadget in the gadget list (see the"
  145. DATA "ABOUT SUB). I had the same problem also with Mutually"
  146. DATA "Exclusive and Scroller Gadgets. Another problem I met"
  147. DATA "was a failure of the ListView and Scroller gadgets to"
  148. DATA "respond to continous activation of their  arrows with"
  149. DATA "the mouse.  Feeling that there must be proper ways to"
  150. DATA "achieve all these features, I tried hard to solve the"
  151. DATA "problems, but did not succeed. I would therefore like"
  152. DATA "very much and appreciate it, to hear from anyone that"
  153. DATA "know the solutions, or were the problems reside."
  154. DATA ""
  155. DATA "I met no difficulty to implement properly, apparently"
  156. DATA "at least, all the gadgets, by including their list in"
  157. DATA "the structure of a Window before opening it, as shown"
  158. DATA "in WGADS.bas. I cosider this, however, to be a defeat"
  159. DATA "of my original purpose and goal."
  160. DATA ""
  161. DATA "      Benito Lombardi"
  162. DATA "      6632 5th Avenue, Pittsburgh, PA 15206. USA."
  163. DATA "      email: <Lomb+@Pitt.edu>"
  164. DATA ""
  165. END SUB
  166.  
  167. SUB Close.Program (BYVAL et)
  168. SHARED font&,myscr&,m_list&,nil_handle&,setpal,vi&
  169. '-------------
  170. SetPointer WINDOW(7),b.ptr&,15&,15&,-7&,-7&
  171. IF setpal THEN Set.Palettes 2 
  172. IF FEXISTS("CLIPS:file") THEN KILL "CLIPS:file"
  173. IF FEXISTS("CLIPS:0") THEN KILL "CLIPS:0"
  174. '-------------
  175. Dos.Script ":HB2Gads/lacepointer"
  176. FreeRaster b.ptr&,16&,34&
  177. junk&= xClose&(nil_handle&)
  178. '-------------
  179. WINDOW CLOSE 1
  180. SELECT CASE et
  181. =0 :FreeGadgets m_list& :CloseFont font&
  182.  FreeVisualInfo vi& :UnlockPubScreen 0&,myscr&
  183. =1 :EXIT SELECT
  184. =2 :UnlockPubScreen 0&,myscr& :EXIT SELECT
  185. =3 :FreeVisualInfo vi& :UnlockPubScreen 0&,myscr& :EXIT SELECT
  186. =4 :CloseFont font& :FreeVisualInfo vi& :UnlockPubScreen 0&,myscr&
  187.  EXIT SELECT
  188. END SELECT
  189. SCREEN CLOSE 1
  190. STOP
  191. END SUB
  192.  
  193. SUB Create.File
  194. SHARED check.click,imsgClass&
  195. STATIC gadgets,i,j
  196. '-------
  197. Gads.Window 0&,2 :Add1.IDCMPFlags
  198. '-------
  199. f_gad&= 0& :f_list&= 0&
  200. f_gad&= CreateContext&(VARPTR(f_list&))
  201. '-------
  202. FOR i= 0 TO 14 :parm(i)= 0 :NEXT
  203. RESTORE Create_File
  204. REDIM f_gads&(7) :REDIM label$(7)
  205. FOR i= 0 TO 7
  206.     FOR j= 0 TO 8 :READ parm(j) :NEXT :READ label$(i)
  207.  Create.Gadgets f_gad&,f_list&,f_gads&()
  208. NEXT 
  209. junk&= AddGList&(act.win&,f_gads&(0),-1&,-1&,0&)
  210. GT_RefreshWindow act.win&,0&
  211. RefreshGList f_gads&(0),act.win&,0&,-1&
  212. Print.Notes 4
  213. Process.WindowEvents f_gads&()
  214. '-------
  215. IF gid= 7 THEN CloseWindow act.win& :FreeGadgets f_list& :EXIT SUB
  216. '-------
  217. Set.Attribute GA_Disabled&,TRUE&,f_gads&(6)
  218. Set.Attribute GA_Disabled&,TRUE&,f_gads&(7)
  219. SetAPen rport&,0 :RectFill rport&,7&,154&,464&,167&
  220. SetPointer act.win&,b.ptr&,0,0,0,0
  221. '-------
  222. check.click= -1
  223. FOR i= 0 TO 5
  224.  Activate_Gadgets:
  225.  Set.Attribute GA_Disabled&,FALSE&,f_gads&(i)
  226.  junk&= ActivateGadget&(f_gads&(i),act.win&,0&)
  227.  Process.WindowEvents f_gads&()
  228.  IF imsgClass&= 8 OR imsgClass&= 256 THEN Activate_Gadgets
  229. NEXT
  230. check.click= 0
  231. '-------
  232. FOR i= 0 TO 5 : Get.String txt$(i),f_gads&(i) :NEXT
  233. '-------
  234. junk&= RemoveGList&(act.win&,f_gads&(0),-1&)
  235. o_list&= f_list&
  236. SetRast rport&,0
  237. '-------
  238. f_gad&= 0& :f_list&= 0&
  239. f_gad&= CreateContext&(VARPTR(f_list&))
  240. '-------
  241. parm(14)= 1 :RESTORE Created_File
  242. REDIM f_gads&(7) :REDIM label$(7)
  243. FOR i= 0 TO 7
  244.     FOR j= 0 TO 8 :READ parm(j) :NEXT :READ label$(i)
  245.  Create.Gadgets f_gad&,f_list&,f_gads&()
  246. NEXT 
  247. junk&= AddGList&(act.win&,f_gads&(0),-1&,-1&,0&)
  248. GT_RefreshWindow act.win&,0&
  249. RefreshGList f_gads&(0),act.win&,0&,-1&
  250. Print.Notes 44
  251. Process.WindowEvents f_gads&()
  252. '-------
  253. CloseWindow act.win&
  254. FreeGadgets f_list&
  255. FreeGadgets o_list&
  256. OPEN "o",#1,"CLIPS:file"
  257.  FOR i= 0 TO 5 :PRINT #1,txt$(i) :NEXT
  258. CLOSE #1
  259. FOR i= 0 TO 14: txt$(i)= "" :NEXT
  260. EXIT SUB
  261. '-------
  262. Create_File:
  263. DATA 0,221, 63,180,12,0,12,23,1,"Family Name"
  264. DATA 1,221, 75,180,12,0,12,23,1,"Inits & First Name"
  265. DATA 2,221, 87,180,12,0,12,23,1,"Street Address"
  266. DATA 3,221, 99,180,12,0,12,23,1,"City"
  267. DATA 4,221,111,180,12,0,12,23,1,"State/Zip Code"
  268. DATA 5,221,123,180,12,0,12,23,1,"Telephone #"
  269. DATA 6,  8,155, 44,12,0, 1, 0,0,"_O k"
  270. DATA 7,392,155, 72,12,0, 1, 0,0,"_Cancel"
  271. '-------
  272. Created_File:
  273. DATA 0,221, 63,180,12,6,13,23,0,"Family Name:"
  274. DATA 1,221, 75,180,12,6,13,23,0,"Inits & First Name:"
  275. DATA 2,221, 87,180,12,6,13,23,0,"Street Address:"
  276. DATA 3,221, 99,180,12,6,13,23,0,"City:"
  277. DATA 4,221,111,180,12,6,13,23,0,"State/Zip Code:"
  278. DATA 5,221,123,180,12,6,13,23,0,"Telephone #:"
  279. DATA 6,  8,155, 44,12,0, 1, 0,0,"_O K"
  280. DATA 7,421,155, 44,12,0, 1, 0,0,"_O K"
  281. END SUB
  282.  
  283. SUB Edit.File
  284. SHARED check.click
  285. STATIC gadgets,i,j
  286. '-----
  287. IF FEXISTS("CLIPS:file") THEN
  288.  OPEN "i",#1,"CLIPS:file" :FOR i= 0 TO 5 :INPUT #1,txt$(i) :NEXT :CLOSE #1
  289. ELSE
  290.  EXIT SUB
  291. END IF
  292. '-----  
  293. Gads.Window 0&,2 :Add1.IDCMPFlags
  294. '-----
  295. f_gad&= 0& :f_list&= 0&
  296. f_gad&= CreateContext&(VARPTR(f_list&))
  297. '-----
  298. FOR i= 0 TO 14 :parm(i)= 0 :NEXT :parm(13)= 1
  299. RESTORE Create_File
  300. REDIM f_gads&(5) :REDIM label$(5)
  301. FOR i= 0 TO 5
  302.     FOR j= 0 TO 8 :READ parm(j) :NEXT :parm(8)= 0 :READ label$(i)
  303.  Create.Gadgets f_gad&,f_list&,f_gads&()
  304. NEXT
  305. junk&= AddGList&(act.win&,f_gads&(0),-1&,-1&,0&)
  306. GT_RefreshWindow act.win&,0&
  307. RefreshGList f_gads&(0),act.win&,0&,-1&
  308. Print.Notes 3
  309. '-----
  310. check.click= -1
  311. Process.WindowEvents f_gads&()
  312. Raw.Key
  313. check.click= 0
  314. '-----
  315. FOR i= 0 TO 5 :Get.String txt$(i),f_gads&(i) :NEXT
  316. '-----
  317. junk&= RemoveGList&(act.win&,f_gads&(0),-1&)
  318. o_list&= f_list&
  319. SetRast rport&,0
  320. '-----
  321. f_gad&= 0& :f_list&= 0&
  322. f_gad&= CreateContext&(VARPTR(f_list&))
  323. '-----
  324. parm(14)= 1 :RESTORE Created_File
  325. REDIM f_gads&(7) :REDIM label$(7)
  326. FOR i= 0 TO 7
  327.     FOR j= 0 TO 8 :READ parm(j) :NEXT :READ label$(i)
  328.     IF i< 6 THEN parm(8)= 1 ELSE parm(8)= 0
  329.  Create.Gadgets f_gad&,f_list&,f_gads&()
  330. NEXT 
  331. junk&= AddGList&(act.win&,f_gads&(0),-1&,-1&,0&)
  332. GT_RefreshWindow act.win&,0&
  333. RefreshGList f_gads&(0),act.win&,0&,-1&
  334. Print.Notes 33
  335. Process.WindowEvents f_gads&()
  336. '-----
  337. CloseWindow act.win&
  338. FreeGadgets f_list&
  339. FreeGadgets o_list&
  340. OPEN "o",#1,"CLIPS:file"
  341.  FOR i= 0 TO 5 :PRINT #1,txt$(i) :NEXT
  342. CLOSE #1
  343. FOR i= 0 TO 14: txt$(i)= "" :NEXT
  344. END SUB
  345.  
  346. SUB Main.Menu
  347. SHARED m_list&
  348. STATIC i,j
  349. '---
  350. Add1.IDCMPFlags
  351. Bevel.Boxes 0
  352. '---
  353. m_gad&= 0& :m_list&= 0&
  354. m_gad&= CreateContext&(VARPTR(m_list&))
  355. '---
  356. parm(4)= 14 :parm(5)= 0 :parm(6)= 1
  357. FOR i= 7 TO 14 :parm(i)= 0 :NEXT
  358. RESTORE Main_Options
  359. REDIM label$(16) :REDIM m_gads&(16)
  360. FOR i= 0 TO 16 :parm(0)= i
  361.  FOR j= 1 TO 3 :READ parm(j) :NEXT :READ label$(i)
  362.  Create.Gadgets m_gad&,m_list&,m_gads&()
  363. NEXT
  364. '---
  365. junk&= AddGList&(WINDOW(7),m_gads&(0),-1&,-1&,0&)
  366. GT_RefreshWindow WINDOW(7),0&
  367. RefreshGList m_gads&(0),WINDOW(7),0&,-1& 
  368. '-
  369. DO
  370.  WINDOW 1 :act.win&= WINDOW(7)
  371.  Process.WindowEvents m_gads&()
  372.  SELECT CASE gid
  373.  = 1 :Palette.Editor
  374.  = 2 :Text.Display
  375.  = 3 :Edit.File
  376.  = 4 :Create.File
  377.  =13 :Close.Program et
  378.  =14 :About.Text
  379.  =REMAINDER :Set.Gadgets
  380.  END SELECT        
  381.  RESTORE Main_Labels :REDIM label$(16)
  382.  FOR i= 0 TO 16 :READ label$(i) :NEXT
  383. LOOP
  384. EXIT SUB
  385. '---
  386. Main_Options:
  387. DATA 148,140,168,"_MX Cycle (SH)"
  388. DATA 324,140,168,"Palette _Editor"
  389. DATA 324,122,168,"Te_xt Display"
  390. DATA 236,122,80,"St_ring"
  391. DATA 148,122,80,"S_tring"
  392. DATA 148,104,80,"Sli_der"
  393. DATA 236,104,80,"S_croller"
  394. DATA 324,104,80,"_Palette"
  395. DATA 412,104,80,"_String"
  396. DATA 412, 86,80,"Listvie_w"
  397. DATA 324, 86,80,"Listvi_ew"
  398. DATA 236, 86,80,"List_view"
  399. DATA 148, 86,80,"_Listview"
  400. DATA 148, 68,80,"_Q u i t"
  401. DATA 236, 68,80,"_About"
  402. DATA 324, 68,80,"Chec_kbox"
  403. DATA 412, 68,80,"_Integer"
  404. '---
  405. Main_Labels:
  406. DATA "_MX Cycle (SH)","Palette _Editor","Te_xt Display","St_ring"
  407. DATA "S_tring","Sli_der","S_croller","_Palette","_String"
  408. DATA "Listvie_w","Listvi_ew","List_view","_Listview"
  409. DATA "_Q u i t","_About","Chec_kbox","_Integer"
  410. END SUB
  411.  
  412. SUB Palette.Editor
  413. SHARED setpal
  414. STATIC gadgets,i,j,palset
  415. '-------
  416. IF palset= 0 THEN palset= 1 :Set.Palettes 0
  417. '-------
  418. f_gad&= 0& :f_list&= 0&
  419. f_gad&= CreateContext&(VARPTR(f_list&))
  420. '-------
  421. FOR i= 0 TO 14 :parm(i)= 0 :NEXT
  422. RESTORE Palette_Editor
  423. REDIM f_gads&(5) :REDIM label$(5)
  424. FOR i= 0 TO 5
  425.     FOR j= 0 TO 13 :READ parm(j) :NEXT :READ label$(i)
  426.  Create.Gadgets f_gad&,f_list&,f_gads&()
  427. NEXT 
  428. Gads.Window f_list&,0 :Add2.IDCMPFlags
  429. Print.Notes 1
  430. Process.WindowEvents f_gads&()
  431. '-------
  432. IF gid= 0 THEN setpal= 0 :palset= 0 :p(12)= 0 :Set.Palettes 2
  433. CloseWindow act.win&
  434. FreeGadgets f_list&
  435. EXIT SUB
  436. '-------
  437. Palette_Editor:
  438. DATA 0,262,141, 56,12,0, 1,0, 0,0, 0,0,0,0,"_Cancel"
  439. DATA 1,139,141, 56,12,0, 1,0, 0,0, 0,0,0,0,"_Use"
  440. DATA 2,177, 72,181,12,0,11,0,15,0, 1,1,1,1,"Red:   "
  441. DATA 3,177, 88,181,12,0,11,0,15,0, 1,1,1,1,"Green:   "
  442. DATA 4,177,104,181,12,0,11,0,15,0, 1,1,1,1,"Blue:   "
  443. DATA 5,111, 48,249,20,0, 8,2, 0,0,40,0,0,0,""
  444. END SUB
  445.  
  446. SUB Set.Gadgets
  447. SHARED cy$(),cyi$(),mx$(),mxi$(),shi1$(),shi2$()
  448. STATIC gadgets,i,j
  449. '---
  450. f_gad&= 0& :f_list&= 0&
  451. f_gad&= CreateContext&(VARPTR(f_list&))
  452. '---
  453. which= gid :parm= 8
  454. FOR i= 0 TO 14 :parm(i)= 0 :NEXT
  455. '---
  456. REDIM label$(1) :REDIM f_gads&(1) :RESTORE Button_Gads
  457. FOR i= 0 TO 1
  458.  FOR j= 0 TO parm :READ parm(j) :NEXT :READ label$(i)
  459.  Create.Gadgets f_gad&,f_list&,f_gads&()
  460. NEXT
  461. '---
  462. SELECT CASE which
  463. =0 :String.Array mx$(),mxi$(),0 :String.Array cy$(),cyi$(),1
  464.  String.Array sh1$(),shi1$(),2 :String.Array sh2$(),shi2$(),3
  465.  parm= 7 :parm(11)= 3 :RESTORE MXCySH_Gads
  466. =5 :parm= 13 :RESTORE Slider_Gads
  467. =6 :parm= 13 :RESTORE Scroller_Gads
  468. =7 :parm= 11 :RESTORE Palette_Gads
  469. =8 :parm= 11 :RESTORE String_Gads
  470. =9 :c(0)= 14 :Create.ViewList viewlist&,0
  471.  RESTORE ListView_Gads1
  472. =10 :c(0)= 8 :Create.ViewList viewlist&,0
  473.  parm= 7 :RESTORE ListView_Gads2
  474. =11: c(0)= 9 :Create.ViewList viewlist&,0
  475.  parm= 6 :RESTORE ListView_Gads3
  476. =12 :c(0)= 10 :Create.ViewList viewlist&,0
  477.  RESTORE ListView_Gads4
  478. =15 :parm= 6 :RESTORE CheckBox_Gads
  479. =16 :String.Array mx$(),mxi$(),4
  480.  parm= 12 :RESTORE Integer_Gads
  481. END SELECT
  482. '---
  483. READ gadgets
  484. REDIM PRESERVE label$(gadgets) :REDIM PRESERVE f_gads&(gadgets)
  485. FOR i= 2 TO gadgets
  486.  FOR j= 0 TO parm :READ parm(j) :NEXT :READ label$(i)
  487.  Create.Gadgets f_gad&,f_list&,f_gads&()
  488. NEXT
  489. Gads.Window f_list&,0 :Add2.IDCMPFlags
  490. Print.Notes which
  491. Process.WindowEvents f_gads&()
  492. '---
  493. CloseWindow act.win&
  494. FreeGadgets f_list&
  495. '---
  496. SELECT CASE which
  497. =0 :ERASE cy$,cyi$,mx$,mxi$,sh1$,shi1$,sh2$,shi2$
  498. =9,10,11,12 :Free.ViewList    viewlist&
  499.  IF FEXISTS("CLIPS:list") THEN KILL "CLIPS:list"
  500. =16 :ERASE mx$,mxi$
  501. END SELECT
  502. FOR i= 0 TO 14: txt$(i)= "" :NEXT
  503. EXIT SUB
  504. '---
  505. Button_Gads:
  506. DATA 0,  8,155,44,12,0,1,0,0,"_O K"
  507. DATA 1,421,155,44,12,0,1,0,0,"_O K"
  508. '---
  509. MXCySH_Gads:
  510. DATA 8
  511. DATA 2,321, 77, 0, 0,2, 5,0,"_D"
  512. DATA 3,151, 76,72,12,0, 7,0,"_Cycle"
  513. DATA 4,151, 92,72,12,0,12,4,"(SH)1"
  514. DATA 5,151,108,72,12,0,12,4,"(SH)2"
  515. DATA 6,118,155,40,12,6,13,0,"Added:"
  516. DATA 7,236,155,40,12,6,13,0,"Result:"
  517. DATA 8,370,155,40,12,6,13,0,"Selected:"
  518. '---
  519. Slider_Gads:
  520. DATA 11
  521. DATA  2,171, 43,200, 12,0,11, 0, 99, 0,0,1,1,1,""
  522. DATA  3,171, 59,200, 12,0,11, 0, 99, 0,0,1,1,1,"S_lider"
  523. DATA  4,171, 75,200, 12,0,11, 0, 49, 0,2,1,1,1,"Sl_ider"
  524. DATA  5,171, 91,200, 12,0,11,50, 99,50,1,1,1,1,"Sli_der:   "
  525. DATA  6,171,107,200, 12,0,11,50,149,50,1,1,1,1,"Slid_er:    "
  526. DATA  7,171,135,200, 12,0,11,50,149,50,4,1,1,1,"Slide_r"
  527. DATA  8, 20, 43, 24, 95,0,11,50, 99,50,8,1,1,2,"_S"
  528. DATA  9,428, 43, 24,104,0,11, 0, 49, 0,4,1,1,2,""
  529. DATA 10,151,155, 40, 12,6,13, 0,  0, 0,0,0,0,0,"Result:"
  530. DATA 11,345,155, 40, 12,6,13, 0,  0, 0,0,0,0,0,"Selected:"
  531. '---
  532. Scroller_Gads:
  533. DATA 5
  534. DATA 2,  8,124,430, 10,0,9,1,593,198,12,0,0,1,""
  535. DATA 3,  8,134,430, 10,0,9,1,593,198, 0,0,0,1,""
  536. DATA 4,420, 40, 18, 83,0,9,1,239, 80, 8,0,0,2,""
  537. DATA 5,439, 40, 18,104,0,9,1,239, 80, 0,0,0,2,""
  538. '---
  539. Palette_Gads:
  540. DATA 8
  541. DATA 2, 52, 47,100,12,3, 8, 2,1,0, 0, 0,"One"
  542. DATA 3, 52, 63,100,15,2, 8, 2,2,0,48, 0,"Two"
  543. DATA 4, 52, 95,100,28,4, 8, 2,1,0, 0,12,"_Three"
  544. DATA 5,229, 47, 66,79,0, 8, 2,3,0,31, 0,"_Five"
  545. DATA 6,326, 47, 31,79,4, 8, 2,1,0, 0, 0,"Four"
  546. DATA 7,384, 47, 31,75,3, 8, 2,0,0, 0,15,"Six"
  547. DATA 8,182,155, 40,12,2,13,12,0,0, 0, 0,"Selected"
  548. '---
  549. String_Gads:
  550. DATA 7
  551. DATA 2, 96, 71,116,12,0,12,12,0,0,0,0,"Input1"
  552. DATA 3,314, 71,116,12,0,12,12,0,1,0,0,"_Input2"
  553. DATA 4, 96, 87,116,12,0,12,12,0,0,1,1,"I_nput3"
  554. DATA 5,314, 87,116,12,0,12,12,0,2,0,1,"Input4"
  555. DATA 6,146,103,232,12,6,12,24,0,0,0,0,"_Edit"
  556. DATA 7,146,119,232,12,6,13,24,1,0,0,0,"Result"
  557. '---
  558. ListView_Gads1:
  559. DATA 4
  560. DATA 2, 76,43,120,20,0,4,0,1,"_Lines"
  561. DATA 3, 76,99,120,40,0,4,0,1,"Li_nes"
  562. DATA 4,272,43,120,96,0,4,0,1,"Line_s"
  563. '---
  564. ListView_Gads2:
  565. DATA 3
  566. DATA 2,  0, 0,120,12,0,12,10," "
  567. DATA 3,174,71,120,48,0, 4, 0,"Lines"
  568. '---
  569. ListView_Gads3:
  570. DATA 3
  571. DATA 2, 80,71,120,48,4,4,"Lines"
  572. DATA 3,272,71,120,48,0,4,"_Lines"
  573. '---
  574. ListView_Gads4:
  575. DATA 4
  576. DATA 2, 80, 71,120,48,0, 4,0,0,"Lines"
  577. DATA 3,272, 71,120,48,4, 4,0,0,"_Lines"
  578. DATA 4,217,155,120,12,6,13,0,1,"Selected:"
  579. '---
  580. CheckBox_Gads:
  581. DATA 6
  582. DATA 2,388,58,0,0,0,2,"High"
  583. DATA 3,388,74,0,0,0,2,"Medium"
  584. DATA 4,388,90,0,0,0,2,"Low"
  585. DATA 5,114,58,0,0,0,2,"Loader"
  586. DATA 6,114,90,0,0,0,2,"Percent"
  587. '---
  588. Integer_Gads:
  589. DATA 8
  590. DATA 2,160, 75,100,12,0,3,10,0,10,0,0,1,"Int1"
  591. DATA 3,160, 91,100,12,0,3,10,0,10,0,0,2,"_Int2"
  592. DATA 4,160,107,100,12,0,3,10,0,10,0,1,1,"I_nt3"
  593. DATA 5,160,123,100,12,0,3,10,0,10,0,1,1,"Int4"
  594. DATA 6,126,155,100,12,6,6, 0,0, 0,1,0,0,"Input:"
  595. DATA 7,310,155,100,12,6,6, 0,0, 0,0,0,0,"Result:"
  596. DATA 8,333, 75,  0, 0,0,5, 0,0, 0,0,8,0,"Ops"
  597. '---
  598. END SUB
  599.  
  600. SUB text.Display
  601. STATIC gadgets,i,j
  602. '---
  603. RESTORE About_Text :txt$= ""
  604. FOR i= 0 TO 14 :READ txt$(5) :txt$= txt$+txt$(5)+" " :NEXT
  605. txt$= LTRIM$(RTRIM$(txt$)) :txt$= txt$+" "
  606. WHILE INSTR(txt$,"  ") >0
  607.  t= INSTR(txt$,"  ")
  608.  txt$= LEFT$(txt$,t-1)+MID$(txt$,t+1)
  609. WEND :txt$(5)= LEFT$(txt$,49)
  610. '---
  611. f_gad&= 0& :f_list&= 0&
  612. f_gad&= CreateContext&(VARPTR(f_list&))
  613. '---
  614. FOR i= 0 TO 14 :parm(i)= 0 :NEXT :parm(14)= 1
  615. REDIM label$(5) :REDIM f_gads&(5) :RESTORE Text_Gads
  616. FOR i= 0 TO 5
  617.  FOR j= 0 TO 13 :READ parm(j) :NEXT :READ label$(i)
  618.  Create.Gadgets f_gad&,f_list&,f_gads&()
  619. NEXT
  620. '---
  621. Gads.Window f_list&,0 :Add1.IDCMPFlags
  622. Print.Notes 2
  623. Process.WindowEvents f_gads&()
  624. '---
  625. IF gid= 3 THEN Bail_Out
  626. '---
  627. Once_Again:
  628. ClearPointer act.win&
  629. '---
  630. Set.Attribute GA_Disabled&,TRUE&,f_gads&(0)
  631. Set.Attribute GA_Disabled&,TRUE&,f_gads&(3)
  632. Set.Attribute GA_Disabled&,FALSE&,f_gads&(1)
  633. Set.Attribute GA_Disabled&,FALSE&,f_gads&(2)
  634. Set.Attribute GA_Disabled&,FALSE&,f_gads&(4)
  635. '---
  636. i= 0 :l= LEN(txt$) :pause= 0
  637. WHILE i< l
  638.  Set_Pause:
  639.  '--
  640.  IF pause THEN
  641.   junk&= xWait&(1& << PEEKB(PEEKL(act.win&+UserPort)+mp_SigBit))
  642.  END IF
  643.  imsg&= GT_GetIMsg&(PEEKL(act.win&+UserPort))
  644.  gad&= PEEKL(imsg&+IAddress)
  645.  code= PEEKW(imsg&+IntuiMessageCode)
  646.  GT_ReplyIMsg imsg&
  647.  gid= PEEKW(gad&+gadgetgadgetid)
  648.  '--
  649.  IF gid= 1 THEN
  650.   IF pause= 0 THEN DECR pause ELSE INCR pause
  651.   IF pause THEN GOTO Set_Pause ELSE EXIT IF
  652.  ELSEIF gid= 2 THEN
  653.   EXIT WHILE
  654.     ELSEIF gid= 4 THEN c(0)= code
  655.  END IF
  656.  '--
  657.  junk&= ActivateGadget&(f_gads&(5),act.win&,0&)
  658.  INCR i :txt$(5)= MID$(txt$,i,49)
  659.  Set.Attribute GTTX_Text&,SADD(""+CHR$(0)),f_gads&(5)
  660.  Set.Attribute GTTX_Text&,SADD(txt$(5)+CHR$(0)),f_gads&(5)
  661.  Delay c(0)
  662. WEND
  663. '---
  664. Set.Attribute GA_Disabled&,FALSE&,f_gads&(0)
  665. Set.Attribute GA_Disabled&,FALSE&,f_gads&(3)
  666. Set.Attribute GA_Disabled&,TRUE&,f_gads&(1)
  667. Set.Attribute GA_Disabled&,TRUE&,f_gads&(2)
  668. Set.Attribute GA_Disabled&,TRUE&,f_gads&(4)
  669. '---
  670. Process.WindowEvents f_gads&()
  671. IF gid= 0 THEN 
  672.  Set.Attribute GTTX_Text&,SADD(""+CHR$(0)),f_gads&(5)
  673.  GOTO Once_Again
  674. END IF
  675. '---
  676. Bail_Out:
  677. CloseWindow act.win&
  678. FreeGadgets f_list&
  679. EXIT SUB
  680. '---
  681. Text_Gads:
  682. DATA 0,  8,155, 96,12,0, 1, 0, 0, 0,0,0,0,0,"_Click Here"
  683. DATA 1,128,155, 96,12,0, 1, 0, 1, 0,0,0,0,0,"P a u s e"
  684. DATA 2,249,155, 96,12,0, 1, 0, 1, 0,0,0,0,0,"S t o p"
  685. DATA 3,369,155, 96,12,0, 1, 0, 0, 0,0,0,0,0,"_E x i t"
  686. DATA 4,131, 91,200,12,0,11, 5,15,10,2,1,1,1,""
  687. DATA 5, 43, 63,392,14,0,13, 0, 0, 0,0,0,0,0,""
  688. END SUB
  689.  
  690. '''''''''''''''''''''''''''''
  691. 'GADGETS: CREATE SUB PROGRAMS
  692. '''''''''''''''''''''''''''''
  693. SUB Bevel.Boxes (BYVAL which)
  694. SHARED FboxTags&(),RboxTags&()
  695. '-------
  696. SELECT CASE which
  697. =0 :RESTORE Main_Boxes
  698.  FOR i= 0 TO 2 :READ lef&,topp&,vidth&,height&
  699.   DrawBevelBoxA rport&,lef&,topp&,vidth&,height&,VARPTR(FboxTags&(0))
  700.  NEXT :Prin.T "G A D T O O L S  G A D G E T S",102,0,13
  701. =1 :DrawBevelBoxA rport&,72,36,311,93,VARPTR(FboxTags&(0))
  702.  DrawBevelBoxA rport&,72,133,311,28,VARPTR(FboxTags&(0))
  703. =3 :DrawBevelBoxA rport&,52,55,366,88,VARPTR(FboxTags&(0))
  704. =8 :SetAPen rport&,1 :RectFill rport&,11,41,415,121
  705.  DrawBevelBoxA rport&,8,40,204,83,VARPTR(FboxTags&(0))
  706.  DrawBevelBoxA rport&,214,40,204,83,VARPTR(FboxTags&(0))
  707.  c(1) =12 :c(2) =210 :c(3) =218 :c(4) =415 :c(5)=42 :c(6) =121
  708.  FOR i= 7 TO 10 :c(i)= 0 :NEXT
  709. =16 :c(0)= 114 :c(1)= 111 :c(2)= 127 :c(3)= 295
  710.  DrawBevelBoxA rport&,114,110,300,12,VARPTR(RboxTags&(0))
  711.  DrawBevelBoxA rport&,114,126,300,12,VARPTR(RboxTags&(0))
  712. END SELECT
  713. EXIT SUB
  714. '-------
  715. Main_Boxes:
  716. DATA   0, 0,640, 20
  717. DATA   0,21,640,179
  718. DATA 132,60,376,102
  719. END SUB
  720.  
  721. SUB Create.Gadgets (gad&,glist&,gads&())
  722. SHARED AGadgetTags&(),cy$(),GadgetTags&()
  723. SHARED mx$(),ng(),viewlist&,topaz80(),shi1$()
  724. '-----
  725. my.gads= UBOUND(gads&,1)
  726. '-----
  727. gid= parm(0)
  728. flags&= (0& AND parm(5)= 0)+(PLACETEXT_LEFT& AND parm(5)= 1)+ _
  729.  (PLACETEXT_RIGHT& AND parm(5)= 2)+(PLACETEXT_ABOVE& AND parm(5)= 3)+ _
  730.  (PLACETEXT_BELOW& AND parm(5)= 4)+(PLACETEXT_IN& AND parm(5)= 5)+ _
  731.  (NG_HIGHLABEL& AND parm(5)= 6)
  732. gkind= parm(6)
  733. '-----
  734. ng(ng_LeftEdge\2)= parm(1)
  735. ng(ng_TopEdge\2) = parm(2)
  736. ng(ng_Width\2)   = parm(3)
  737. ng(ng_Height\2)  = parm(4)
  738. POKEL VARPTR(ng(ng_TextAttr\2)),VARPTR(topaz80(0))
  739. POKEL VARPTR(ng(ng_GadgetText\2)),SADD(label$(gid)+CHR$(0))
  740. ng(ng_GadgetID\2)= gid
  741. POKEL VARPTR(ng(ng_Flags\2)),flags&
  742. ng(ng_UserData\2)= gkind
  743. '-----
  744. IF gkind= BUTTONKIND THEN
  745.  TAGLIST VARPTR(GadgetTags&(0)), _
  746.   GA_Disabled&, parm(8), _
  747.   GT_Underscore&, "_"%, _
  748.  TAG_DONE&
  749.  
  750. ELSEIF gkind= CHECKBOXKIND THEN
  751.  TAGLIST VARPTR(GadgetTags&(0)), _
  752.   GTCB_Checked&, parm(7), _
  753.   GA_Disabled&, parm(9), _
  754.  TAG_DONE&
  755.  
  756. ELSEIF gkind= INTEGERKIND THEN
  757.  item& =(GACT_STRINGLEFT& AND parm(12)= 1)+ _
  758.   (GACT_STRINGRIGHT& AND parm(12)= 2)+(GACT_STRINGCENTER& AND parm(12)= 4)
  759.  TAGLIST VARPTR(GadgetTags&(0)), _
  760.   GTIN_Number&, parm(9), _
  761.   GTIN_MaxChars&, parm(7), _
  762.   STRINGA_Justification&, item&, _
  763.   STRINGA_ReplaceMode&, parm(13), _
  764.   GA_Disabled&, parm(8), _
  765.   STRINGA_ExitHelp&, parm(14), _
  766.   GA_TabCycle&, parm(11), _
  767.   GT_Underscore&, "_"%, _
  768.  TAG_DONE&
  769.  
  770. ELSEIF gkind= LISTVIEWKIND THEN
  771.  item&= 16
  772.  IF c(0)= 8 THEN
  773.   TAGLIST VARPTR(AGadgetTags&(0)),GTLV_ShowSelected&,gads&(gid-1),TAG_DONE&
  774.  ELSEIF c(0)= 9 THEN
  775.   TAGLIST VARPTR(AGadgetTags&(0)),GTLV_ShowSelected&,FALSE&,TAG_DONE&
  776.  ELSE
  777.   IF c(0)= 40 THEN item&= 24
  778.   TAGLIST VARPTR(AGadgetTags&(0)),TAG_DONE&
  779.  END IF
  780.  TAGLIST VARPTR(GadgetTags&(0)), _
  781.   GTLV_Labels&, viewlist&, _
  782.   GTLV_Top&, 0, _
  783.   GTLV_ReadOnly&, parm(8), _
  784.   GTLV_ScrollWidth&, item&, _
  785.   LAYOUTA_Spacing&, 0, _
  786.   GT_Underscore&, "_"%, _
  787.  TAG_MORE&, VARPTR(AGadgetTags&(0))
  788.  
  789. ELSEIF gkind= MXKIND THEN
  790.  TAGLIST VARPTR(GadgetTags&(0)), _
  791.   GTMX_Labels&, VARPTR(mx$(0)), _
  792.   GTMX_Active&, parm(8), _
  793.   GTMX_Spacing&, parm(11), _
  794.   GT_Underscore&, "_"%, _
  795.  TAG_DONE&
  796.  
  797. ELSEIF gkind= NUMBERKIND THEN
  798.  TAGLIST VARPTR(GadgetTags&(0)), _
  799.   GTNM_Number&, parm(9), _
  800.   GTNM_Border&, parm(10), _
  801.  TAG_DONE& 
  802.  
  803. ELSEIF gkind= CYCLEKIND THEN
  804.  TAGLIST VARPTR(GadgetTags&(0)), _
  805.   GTCY_Labels&, VARPTR(cy$(0)), _
  806.   GTCY_Active&, parm(8), _
  807.   GA_Disabled&, parm(9), _
  808.   GT_Underscore&, "_"%, _
  809.  TAG_DONE&
  810.  
  811. ELSEIF gkind= PALETTEKIND THEN
  812.  IF my.gads= 8 THEN
  813.   c(0)= parm(7)+ 1 :IF gid= 4 OR gid= 5 THEN c(gid)= parm(8)
  814.  END IF
  815.  TAGLIST VARPTR(GadgetTags&(0)), _
  816.   GTPA_DEPTH&, parm(7), _
  817.   GTPA_Color&, parm(8), _
  818.   GTPA_ColorOffset&, parm(9), _
  819.   GTPA_IndicatorWidth&, parm(10), _
  820.   GTPA_IndicatorHeight&, parm(11), _
  821.   Ga_Disabled&, parm(12), _
  822.   GT_Underscore&, "_"%, _
  823.  TAG_DONE&
  824.  
  825. ELSEIF gkind= SCROLLERKIND THEN
  826.  SELECT CASE gid
  827.  =2,4 :TAGLIST VARPTR(AGadgetTags&(0)),GTSC_Arrows&,parm(10),TAG_DONE&
  828.  =3,5 :TAGLIST VARPTR(AGadgetTags&(0)),TAG_DONE&
  829.  END SELECT
  830.  '---- 
  831.  TAGLIST VARPTR(GadgetTags&(0)), _
  832.   GTSC_Top&, parm(7), _
  833.   GTSC_Total&, parm(8), _
  834.   GTSC_Visible&, parm(9), _
  835.   GA_Immediate&, parm(11), _
  836.   GA_RelVerify&, parm(12), _
  837.   PGA_Freedom&, parm(13) , _
  838.   Ga_Disabled&, parm(14), _
  839.  TAG_MORE&, VARPTR(AGadgetTags&(0))
  840.  
  841. ELSEIF gkind= SLIDERKIND THEN
  842.  item&= (PLACETEXT_LEFT& AND parm(10)= 1)+ _
  843.   (PLACETEXT_RIGHT& AND parm(10)= 2)+ _
  844.   (PLACETEXT_ABOVE& AND parm(10)= 4)+ _
  845.   (PLACETEXT_BELOW& AND parm(10)= 8)
  846.  IF my.gads= 11 THEN
  847.   c(gid)= parm(7) :c(gid+8)= parm(8) :c(gid+16)= c(gid)
  848.   SELECT CASE gid
  849.   =2,3 :ml= 0
  850.   =4,8,9 :ml= 2 :lf$= "%2ld"
  851.   =5 :ml= 2 :lf$= "%02ld"
  852.   =6 :ml= 4 :lf$= "%03ld"
  853.   =7 :ml= 3 :lf$= "%3ld"
  854.   END SELECT
  855.   SELECT CASE gid
  856.   =4 TO 8 
  857.    TAGLIST VARPTR(AGadgetTags&(0)),GTSL_LevelFormat&,lf$, _
  858.     GTSL_LevelPlace&,item&,TAG_DONE&
  859.   =REMAINDER :TAGLIST VARPTR(AGadgetTags&(0)),TAG_DONE&
  860.   END SELECT
  861.  ELSEIF my.gads= 5 AND label$(0)= "_Cancel" THEN
  862.   parm(9)= (p(0) AND gid= 2)+(p(1) AND gid= 3)+(p(2) AND gid= 4)
  863.   ml= 2 :lf$= "%2ld"
  864.   TAGLIST VARPTR(AGadgetTags&(0)),GTSL_LevelFormat&,lf$, _
  865.    GTSL_LevelPlace&,item&,TAG_DONE&
  866.  ELSEIF my.gads= 5 AND label$(0)= "_Click Here" THEN
  867.   c(0)= parm(9) :ml= 2 :lf$= "%2ld"
  868.   TAGLIST VARPTR(AGadgetTags&(0)),GTSL_LevelFormat&,lf$, _
  869.    GTSL_LevelPlace&,item&,TAG_DONE&
  870.  END IF 
  871.  TAGLIST VARPTR(GadgetTags&(0)), _
  872.   GTSL_Min&, parm(7), _
  873.   GTSL_Max&, parm(8), _
  874.   GTSL_Level&, parm(9), _
  875.   GTSL_MaxLevelLen&, ml, _
  876.   GA_Immediate&, parm(11), _
  877.   GA_RelVerify&, parm(12), _
  878.   PGA_Freedom&, parm(13), _
  879.   GA_Disabled&, parm(14),_
  880.   GT_Underscore&, "_"%, _
  881.  TAG_MORE&, VARPTR(AGadgetTags&(0))
  882.  
  883. ELSEIF gkind= STRINGKIND THEN
  884.  item&= (0& AND parm(13)= 0)+(SADD(txt$(gid)+CHR$(0)) AND parm(13)= 1)
  885.  IF LEFT$(label$(gid),4)= "(SH)" THEN
  886.   item&= SADD(shi1$(0)+CHR$(0)) :parm(12)= 1
  887.  END IF
  888.  place&= (GACT_STRINGLEFT& AND parm(9)= 0)+(GACT_STRINGCENTER& AND _
  889.   parm(9)= 1)+(GACT_STRINGRIGHT& AND parm(9)= 2)
  890.  TAGLIST VARPTR(GadgetTags&(0)), _
  891.   GTST_String&, item&, _
  892.   GTST_MaxChars&, parm(7), _
  893.   GA_Disabled&, parm(8), _ 
  894.   GT_Underscore&, "_"%, _
  895.   STRINGA_Justification&, place&, _
  896.   STRINGA_ReplaceMode&, parm(10), _
  897.   GA_TabCycle&, parm(11), _
  898.   STRINGA_ExitHelp&, parm(12), _
  899.  TAG_DONE&
  900.  
  901. ELSEIF gkind= TEXTKIND THEN
  902.  IF parm(14)= 1 THEN
  903.   TAGLIST VARPTR(GadgetTags&(0)), _
  904.    GTTX_Text&, SADD(txt$(gid)+CHR$(0)), _
  905.    GTTX_Border&, parm(8), _
  906.   TAG_DONE&
  907.  ELSE
  908.   TAGLIST VARPTR(GadgetTags&(0)), _
  909.    GTTX_Text&, "", _
  910.    GTTX_Border&, parm(8), _
  911.    GTTX_CopyText&, TRUE&, _
  912.   TAG_DONE&
  913.  END IF
  914. END IF
  915. '-----
  916. gad&= CreateGadgetA&(gkind,gad&,VARPTR(ng(0)),VARPTR(gadgetTags&(0)))
  917. '-----
  918. IF gad&<> 0 THEN
  919.  gads&(gid)= gad&
  920. ELSE
  921.  SELECT CASE my.gads
  922.  =16 :Error.Trap 4
  923.  =REMAINDER :CloseWindow act.win& 
  924.   IF viewlist&<> 0& THEN Free.ViewList    viewlist&
  925.   IF FEXISTS("CLIPS:list") THEN KILL "CLIPS:list"
  926.   IF glist&<> 0& THEN FreeGadgets glist&
  927.   Error.Trap 5
  928.  END SELECT
  929. END IF
  930. END SUB
  931.  
  932. SUB Init.TextAttr (t(1),FontName$,BYVAL Height,BYVAL style,BYVAL flags)
  933. POKEL VARPTR(t(0))+ta_Name%,SADD(FontName$+CHR$(0))
  934. t(ta_YSize\2)= Height
  935. POKEB VARPTR(t(0))+ta_Style,style
  936. POKEB VARPTR(t(0))+ta_Flags,flags
  937. END SUB
  938.  
  939. SUB String.Array (ar$(),ari$(),BYVAL which)
  940. STATIC i,off.set
  941. '-----
  942. SELECT CASE which
  943. =0 :RESTORE MX_Items :READ items :c(0)= items
  944. =1,2 :RESTORE CySH_Items :READ items :c(0)= items
  945. =3 :RESTORE SH_Items :READ items :c(4)= items
  946. =4 :RESTORE Op_Items :READ items :c(0)= items
  947. END SELECT
  948. c(1)= 0 :c(2)= 0 :c(3)= 0: c(5)= 0
  949. FOR i= 0 TO items :READ ari$(i) :NEXT
  950. IF which= 2 OR which= 3 THEN
  951.  FOR i= 0 TO items :ari$(i)= ari$(i)+CHR$(0) :NEXT :EXIT SUB
  952. END IF
  953. '-----
  954. off.set= -4
  955. FOR i= 0 TO items
  956.  off.set= off.set+4
  957.  POKEL VARPTR(ar$(0))+off.set,SADD(ari$(i)+CHR$(0))
  958. NEXT
  959. EXIT SUB
  960. '-----
  961. MX_Items:
  962. DATA 3
  963. DATA "_DF0:","DF1:","DF2:","CD0:"
  964. '-----
  965. CySH_Items:
  966. DATA 3
  967. DATA "DF0:","DF1:","DF2:","CD0:"
  968. '-----
  969. SH_Items:
  970. DATA 4
  971. DATA "DF0:","DF1:","DF2:","CD0:",""
  972. '-----
  973. Op_Items:
  974. DATA 3
  975. DATA "+","-","*","/"
  976. END SUB
  977.  
  978. SUB Gads.Window (glist&,BYVAL flags)
  979. SHARED TempTags&(),ATempTags&(),viewlist&
  980. '-----
  981. wa.flags&= WFLG_GIMMEZEROZERO&+ WFLG_BORDERLESS&
  982. IF flags= 1 THEN wa.flags&= wa.flags&+WFLG_CLOSEGADGET&
  983. IF flags= 2 THEN
  984.  TAGLIST VARPTR(ATempTags&(0)),TAG_DONE&
  985. ELSE
  986.  TAGLIST VARPTR(ATempTags&(0)),WA_Gadgets&,glist&,TAG_DONE&
  987. END IF
  988. '-----
  989. TAGLIST VARPTR(TempTags&(0)), _
  990.  WA_Left&, 84&, _
  991.  WA_Top&, 23&, _
  992.  WA_Width&, 472&, _
  993.  WA_Height&, 175&, _
  994.  WA_Activate&, TRUE&, _
  995.  WA_SmartRefresh&, TRUE&, _
  996.  WA_Flags&, wa.flags&, _
  997.  WA_CustomScreen&, PEEKL(SYSTAB+12), _
  998. TAG_MORE&, VARPTR(ATempTags&(0))
  999. '-----
  1000. win&= OpenWindowTagList&(0,VARPTR(TempTags&(0)))
  1001. '-----
  1002. IF win&<> 0 THEN
  1003.  GT_RefreshWindow win&,0&
  1004.  act.win&= win&
  1005.  rport&= PEEKL(win&+rport)
  1006. ELSE
  1007.  IF glist&<> 0& THEN FreeGadgets glist&
  1008.  IF viewlist&<> 0& THEN Free.ViewList    viewlist&
  1009.  Error.Trap 7
  1010. END IF
  1011. END SUB
  1012.  
  1013. '''''''''''''''''''''''''''''
  1014. 'LISTVIEW GADGET SUB PROGRAMS
  1015. '''''''''''''''''''''''''''''
  1016. SUB Add.Name (listh&,txt$)
  1017. STATIC namenode&
  1018. namenode&= AllocMem&(node_sizeof,MEMF_CLEAR&)
  1019. IF namenode&= 0& THEN Error.Trap 6    
  1020. POKEL namenode&+ln_Name,SADD(txt$+CHR$(0))
  1021. AddHead listh&,namenode&
  1022. END SUB
  1023.  
  1024. SUB Create.ViewList (listhead&,BYVAL new)
  1025. SHARED viewlist&
  1026. STATIC i,listhead&
  1027. '-----
  1028. IF new= 0 THEN
  1029.  c(1)= 0 :RESTORE List_Items
  1030.  FOR i= 0 TO c(0) :READ txt$(i) :txt$(i)= txt$(i)+CHR$(0) :NEXT
  1031. ELSEIF new= 1 THEN
  1032.  OPEN"i",#1,"CLIPS:list" :FOR i= 0 TO c(0) :INPUT #1,txt$(i) :NEXT :CLOSE #1
  1033. END IF
  1034. '-----
  1035. listhead&= AllocMem& (list_sizeof,MEMF_CLEAR&)
  1036. NewList listhead&
  1037. FOR i= c(0) TO 0 STEP -1 :Add.Name    listhead&,txt$(i) :NEXT
  1038. viewlist&= listhead& 
  1039. EXIT SUB
  1040. '-----
  1041. List_Items:
  1042. DATA "Line #1","Line #2","Line #3","Line #4","Line #5"
  1043. DATA "Line #6","Line #7","Line #8","Line #9","Line #10"
  1044. DATA "Line #11","Line #12","Line #13","Line #14","Line #15"
  1045. END SUB
  1046.  
  1047. SUB Free.ViewList (BYVAL listhead&)
  1048. STATIC worknode&,nextnode&
  1049. worknode&= PEEKL(ListHead&+lh_head)
  1050. DO
  1051.  nextnode&= PEEKL(worknode&+ln_Succ)
  1052.  IF nextnode&= 0 THEN EXIT LOOP
  1053.  FreeMem worknode&,node_sizeof
  1054.  worknode&= nextnode&
  1055. LOOP
  1056. FreeMem listhead&,16
  1057. END SUB
  1058.  
  1059. ''''''''''''''''''''''''''
  1060. 'WINDOW EVENT SUB PROGRAMS
  1061. ''''''''''''''''''''''''''
  1062. SUB Handle.GadgetEvents (BYVAL code,my_gads&())
  1063. SHARED c&(),cyi$(),gad&,mxi$()
  1064. SHARED terminated,viewlist&
  1065. '----------------
  1066. my.gads= UBOUND(my_gads&,1)
  1067. gid= PEEKW(gad&+gadgetgadgetid)
  1068. gkind= PEEKW(gad&+gadgetuserdata)
  1069. '----------------
  1070. SELECT CASE gkind
  1071.  
  1072. =BUTTONKIND :terminated= 1 :EXIT SUB
  1073.  
  1074. =CHECKBOXKIND :Check.Box gad&,my_gads&() :EXIT SUB
  1075.  
  1076. =INTEGERKIND
  1077.  c&(gid)= PEEKL(PEEKL(my_gads&(gid)+GadgetSpecialInfo)+StringInfoLongInt)
  1078.  Integer.Kind my_gads&() :EXIT SUB
  1079.  
  1080. =LISTVIEWKIND :txt$= txt$(code) :c(27)= code
  1081.  IF label$(2)= " " THEN junk&= ActivateGadget&(my_gads&(2),act.win&,0&)
  1082.  IF c(0)= 10 THEN txt$(14)= txt$ :c(26)= 1 ELSE SOUND 1400,3,85,1 :EXIT SUB
  1083.  
  1084. =MXKIND :c(1)= code :txt$(14)= mxi$(c(1))
  1085.  IF mxi$(0)= "+" THEN
  1086.   junk&= ActivateGadget&(my_gads&(4),act.win&,0&) :EXIT SUB
  1087.  END IF
  1088.  
  1089. =NUMBERKINK :EXIT SUB
  1090.  
  1091. =CYCLEKIND :c(2)= code :txt$(14)= cyi$(c(2))
  1092.  
  1093. =PALETTEKIND
  1094.  IF my.gads= 8 THEN
  1095.   Palette.Kind code
  1096.  ELSEIF my.gads= 5 THEN Edit.Palette code,my_gads&() :EXIT SUB
  1097.  END IF
  1098.  
  1099. =SCROLLERKIND :Area.Fill code :EXIT SUB
  1100.  
  1101. =SLIDERKIND
  1102.  IF my.gads= 11 THEN 
  1103.   Slider.Kind code
  1104.  ELSEIF my.gads= 5 THEN Edit.Palettes code :EXIT SUB
  1105.  END IF
  1106.  
  1107. =STRINGKIND
  1108.  IF LEFT$(label$(gid),4)= "(SH)" THEN
  1109.   Exit.Help code,my_gads&()
  1110.  ELSEIF label$(gid)= " " THEN
  1111.   Edit.ViewList my_gads&(),code :EXIT SUB
  1112.  ELSEIF label$(2)= "Input1" THEN
  1113.   Input.1 my_gads&(),code :EXIT SUB
  1114.  ELSE
  1115.   terminated= 1 :EXIT SUB
  1116.  END IF
  1117.  
  1118. =TEXTKIND :EXIT SUB
  1119.  
  1120. END SELECT
  1121. IF gkind= STRINGKIND AND txt$(14)= "" THEN c(26)= 1
  1122. Result.Selected my_gads&()
  1123. END SUB
  1124.  
  1125. SUB Handle.VanillaKeys (BYVAL code,my_gads&())
  1126. SHARED cyi$(),mxi$(),terminated
  1127. STATIC i,my.gads,txl,txu
  1128. '---------------
  1129. my.gads= UBOUND(my_gads&,1)
  1130. '---------------
  1131. IF code<> 13 THEN
  1132.  vl$= "_"+LCASE$(CHR$(code))
  1133.  vu$= "_"+UCASE$(CHR$(code))
  1134.  FOR i= 0 TO my.gads
  1135.   txl= INSTR(label$(i),vl$)
  1136.   txu= INSTR(label$(i),vu$) 
  1137.   IF txl OR txu THEN gid= i :EXIT FOR
  1138.  NEXT
  1139.  IF txl= 0 AND txu= 0 THEN EXIT SUB
  1140.  '--------------
  1141.  vl$= CHR$(code)
  1142.  gkind= PEEKW(my_gads&(gid)+gadgetuserdata)
  1143.  SELECT CASE gkind
  1144.  
  1145.  =BUTTONKIND :terminated= 1 :EXIT SUB
  1146.  
  1147.  =CHECKBOXKIND : EXIT SUB
  1148.   
  1149.  =INTEGERKIND :junk&= ActivateGadget&(my_gads&(gid),act.win&,0&)
  1150.   EXIT SUB
  1151.  
  1152.  =LISTVIEWKIND
  1153.   IF vl$= MAX(LCASE$(vl$),UCASE$(vl$)) THEN
  1154.    INCR c(1) :IF c(1) >c(0) THEN c(1)= c(0)
  1155.   ELSE
  1156.    DECR c(1) :IF c(1)< 0 THEN c(1)= 0
  1157.   END IF 
  1158.   Set.Attribute GTLV_Top&,c(1),my_gads&(gid)
  1159.   EXIT SUB
  1160.   
  1161.  =MXKIND,CYCLEKIND
  1162.   IF vl$= MAX(LCASE$(vl$),UCASE$(vl$)) THEN
  1163.    IF gkind= MXKIND THEN
  1164.     INCR c(1) :IF c(1) >c(0) THEN c(1)= 0
  1165.     txt$(14)= mxi$(c(1)) :item&= GTMX_Active& :item= c(1)
  1166.    ELSEIF gkind= CYCLEKIND THEN
  1167.     INCR c(2) :IF c(2) >c(0) THEN c(2)= 0
  1168.     txt$(14)= cyi$(c(2)) :item&= GTCY_Active& :item= c(2)
  1169.    END IF
  1170.   ELSE
  1171.    IF gkind= MXKIND THEN
  1172.     DECR c(1) :IF c(1)< 0 THEN c(1)= c(0)
  1173.     txt$(14)= mxi$(c(1)) :item&= GTMX_Active& :item= c(1)
  1174.    ELSEIF gkind= CYCLEKIND THEN
  1175.     DECR c(2) :IF c(2)< 0 THEN c(2)= c(0)
  1176.     txt$(14)= cyi$(c(2)) :item&= GTCY_Active& :item= c(2)
  1177.    END IF
  1178.   END IF
  1179.   Set.Attribute item&,item,my_gads&(gid)
  1180.   IF mxi$(0)= "+" THEN EXIT SUB
  1181.  
  1182.  =NUMBERKIND :EXIT SUB
  1183.  
  1184.  =PALETTEKIND
  1185.   IF vl$= MAX(LCASE$(vl$),UCASE$(vl$)) THEN
  1186.    INCR c(gid) :IF c(gid) >c(0) THEN c(gid)= 0
  1187.   ELSE
  1188.    DECR c(gid) :IF c(gid)< 0 THEN c(gid)= c(0)
  1189.   END IF 
  1190.   Set.Attribute GTPA_Color&,c(gid),my_gads&(gid)
  1191.   EXIT SUB
  1192.   
  1193.  =SCROLLERKIND :EXIT SUB
  1194.  
  1195.  =SLIDERKIND
  1196.      IF vl$= MAX(LCASE$(vl$),UCASE$(vl$)) THEN
  1197.    INCR c(gid) :IF c(gid) >c(gid+8) THEN c(gid)= c(gid+8)
  1198.      ELSE
  1199.    DECR c(gid) :IF c(gid)< c(gid+16) THEN c(gid)= c(gid+16)
  1200.      END IF
  1201.      IF gid= 3 OR gid= 8 THEN c(26)= 0 ELSE c(26)= 3
  1202.   txt$(13)= "" :txt$(14)= STR$(c(gid)) :level= c(gid)
  1203.         Set.Attribute GTSL_Level&,level,my_gads&(gid)
  1204.  
  1205.     =STRINGKIND :junk&= ActivateGadget&(my_gads&(gid),act.win&,0&)
  1206.   EXIT SUB
  1207.  
  1208.  =TEXTKIND :EXIT SUB
  1209.  
  1210.     END SELECT
  1211. ELSEIF code= 13 THEN
  1212.  c(26)= 0
  1213. END IF
  1214. Result.Selected my_gads&()
  1215. END SUB
  1216.  
  1217. SUB Process.WindowEvents (my_gads&())
  1218. SHARED check.click,gad&,imsgClass&,terminated
  1219. STATIC imsg&
  1220. '-----------
  1221. IF NOT check.click THEN ClearPointer act.win&
  1222. SOUND 1400,3,85,1
  1223. terminated= 0
  1224. '-----------
  1225. WHILE terminated= 0
  1226.  junk&= xWait&(1& << PEEKB(PEEKL(act.win&+UserPort)+mp_SigBit))
  1227.  DO
  1228.   imsg&= GT_GetIMsg(PEEKL(act.win&+UserPort))
  1229.   IF imsg&= 0 THEN EXIT LOOP
  1230.   '---------
  1231.   gad&= PEEKL(imsg&+IAddress)
  1232.   imsgClass&= PEEKL(imsg&+Class)
  1233.   imsgCode= PEEKW(imsg&+IntuiMessageCode)
  1234.   GT_ReplyIMsg imsg&
  1235.   '---------
  1236.   SELECT CASE imsgClass&
  1237.   =IDCMP_MOUSEBUTTONS&,IDCMP_MENUPICK&
  1238.    IF check.click THEN EXIT SUB
  1239.   =IDCMP_GADGETDOWN&,IDCMP_GADGETUP&,IDCMP_MOUSEMOVE&
  1240.    Handle.GadgetEvents imsgCode,my_gads&()
  1241.   =IDCMP_VANILLAKEY&
  1242.    Handle.VanillaKeys imsgCode,my_gads&()
  1243.   =IDCMP_CLOSEWINDOW& :terminated= 1
  1244.   =IDCMP_REFRESHWINDOW&
  1245.    GT_BeginRefresh act.win& :GT_EndRefresh act.win&,TRUE&
  1246.   END SELECT
  1247.  LOOP UNTIL terminated
  1248. WEND
  1249. IF NOT check.click THEN SetPointer act.win&,b.ptr&,15&,15&,-7&,-7&
  1250. END SUB
  1251.  
  1252. SUB Raw.Key
  1253. POKE &HBFEC01,0
  1254. DO
  1255.  junk&= xWait&(1& << PEEKB(PEEKL(act.win&+UserPort)+mp_SigBit))
  1256.  imsg&= GT_GetIMsg&(PEEKL(act.win&+UserPort))
  1257.  imsgClass&= PEEKL(imsg&+Class)
  1258.  GT_ReplyIMsg imsg&
  1259.  IF imsgClass&= IDCMP_VANILLAKEY& THEN
  1260.   rawKey= PEEK(&HBFEC01) :IF rawKey= 119 THEN EXIT LOOP
  1261.  END IF
  1262. LOOP
  1263. END SUB
  1264.  
  1265. ''''''''''''''''''''''''''
  1266. 'GADGET EVENT SUB PROGRAMS
  1267. ''''''''''''''''''''''''''
  1268. SUB Area.Fill (BYVAL code)
  1269. STATIC apen,y&,y1&,x&,x1&
  1270. '---------
  1271. x&= (c(3) AND gid= 4)+(c(1) AND gid= 5)
  1272. x1&=(c(4) AND gid= 4)+(c(2) AND gid= 5)
  1273. y&= c(5) :y1&= c(6)
  1274. '---------
  1275. SELECT CASE gid
  1276. =2,3
  1277.  IF c(gid+5)< code THEN
  1278.   apen= 2
  1279.   IF gid= 2 THEN x&= c(3) :x1&= x&+(code\2)
  1280.   IF gid= 3 THEN x&= c(1) :x1&= x&+(code\2)
  1281.  ELSEIF c(gid+5) >code THEN
  1282.   apen= 1
  1283.   IF gid= 2 THEN x&= c(3)+(code\2) :x1&= c(4)
  1284.   IF gid= 3 THEN x&= c(1)+(code\2) :x1&= c(2)
  1285.  END IF
  1286. =4,5
  1287.  IF c(gid+5)< code THEN
  1288.   apen= 2 :y&= c(5) :y1&= y&+(code\2)
  1289.  ELSEIF c(gid+5) >code THEN
  1290.   apen= 1 :y&= c(5)+(code\2) :y1&= c(6)
  1291.  END IF
  1292. END SELECT
  1293. '---------
  1294. SetAPen rport&,apen :RectFill rport&,x&,y&,x1&,y1&
  1295. c(gid+5)= code
  1296. SetAPen rport&,1
  1297. END SUB
  1298.  
  1299. SUB Check.Box (BYVAL gad&,my_gads&())
  1300. STATIC state,x&,x1&,y&
  1301. '---------------------
  1302. state= PEEK(PEEKW(gad&+GadgetFlags)+5)
  1303. IF state= GFLG_SELECTED& THEN
  1304.  SELECT CASE gid
  1305.  =2 :SOUND 2800,3,85,1
  1306.  =3 :SOUND 1400,3,85,1
  1307.  =4 :SOUND  700,3,85,1
  1308.  =5,6 :Fill.Area gid
  1309.  END SELECT
  1310.  SELECT CASE gid
  1311.  =2 TO 4 :Set.Attribute GTCB_Checked&,0,my_gads&(gid)
  1312.  =5 :Set.Attribute GA_Disabled&,TRUE&,my_gads&(gid)
  1313.  END SELECT
  1314. ELSE
  1315.  IF gid =6 THEN
  1316.   x&= c(0)+2 :x1&= c(0)+c(3)+2 :y&= c(2)
  1317.   SetAPen& rport&,0 :RectFill rport&,x&,y&,x1&,y&+8
  1318.   SetAPen& rport&,1
  1319.  END IF
  1320. END IF
  1321. END SUB
  1322.  
  1323. SUB Edit.Palette (BYVAL code,my_gads&())
  1324. STATIC i
  1325. '-------
  1326. p(12)= code
  1327. SELECT CASE code
  1328. =0 :item&(2)= p(0) :item&(3)= p(1) :item&(4)= p(2)
  1329. =1 :item&(2)= p(3) :item&(3)= p(4) :item&(4)= p(5)
  1330. =2 :item&(2)= p(6) :item&(3)= p(7) :item&(4)= p(8)
  1331. =3 :item&(2)= p(9) :item&(3)= p(10):item&(4)= p(11)
  1332. END SELECT
  1333. FOR i= 2 TO 4 :Set.Attribute GTSL_Level&,item&(i),my_gads&(i) :NEXT
  1334. END SUB
  1335.  
  1336. SUB Edit.Palettes (BYVAL code)
  1337. kolor= p(12)
  1338. SELECT CASE kolor
  1339. =0
  1340.  SELECT CASE gid
  1341.  =2 :p(0)= code
  1342.  =3 :p(1)= code
  1343.  =4 :p(2)= code
  1344.  END SELECT
  1345. =1
  1346.  SELECT CASE gid
  1347.  =2 :p(3)= code
  1348.  =3 :p(4)= code
  1349.  =4 :p(5)= code
  1350.  END SELECT
  1351. =2
  1352.  SELECT CASE gid
  1353.  =2 :p(6)= code
  1354.  =3 :p(7)= code
  1355.  =4 :p(8)= code
  1356.  END SELECT
  1357. =3
  1358.  SELECT CASE gid
  1359.  =2 :p(9) = code
  1360.  =3 :p(10)= code
  1361.  =4 :p(11)= code
  1362.  END SELECT
  1363. END SELECT :Set.Palettes 1
  1364. END SUB
  1365.  
  1366. SUB Edit.ViewList (my_gads&(),BYVAL code)
  1367. SHARED viewlist&
  1368. '---------------
  1369. Get.String txt$,my_gads&(gid) :SOUND 1400,3,85,1
  1370. IF gid= 2 THEN
  1371.  txt$(c(27))= txt$+CHR$(0)
  1372.  OPEN "o",#1,"CLIPS:list"
  1373.   FOR i= 0 TO c(0) :PRINT #1,txt$(i) :NEXT
  1374.  CLOSE #1 :Free.ViewList    viewlist&
  1375.  Create.ViewList viewlist&,1
  1376.  Set.Attribute GTLV_Labels&,viewlist&,my_gads&(gid+1)
  1377.  IF code= 0 THEN Set.Attribute GTST_String&,SADD(""+CHR$(0)),my_gads&(gid)
  1378. END IF
  1379. END SUB
  1380.  
  1381. SUB Exit.Help (BYVAL code,my_gads&())
  1382. SHARED shi1$(),shi2$()
  1383. '---------------
  1384. IF code= 95 THEN
  1385.  SELECT CASE gid
  1386.  =4 :INCR c(3) :IF c(3) >c(0) THEN c(3)= 0
  1387.   item$ = shi1$(c(3))
  1388.  =5 :INCR c(5) :IF c(5) >c(4) THEN c(5)= 0
  1389.   item$= shi2$(c(5)) 
  1390.  END SELECT :txt$(13)= item$
  1391.  Set.Attribute GTST_String&,SADD(item$+CHR$(0)),my_gads&(gid)
  1392.  junk&= ActivateGadget&(my_gads&(gid),act.win&,0&)
  1393.  Get.String txt$(14),my_gads&(gid)
  1394. ELSE
  1395.  IF (gid= 5 AND c(5)= c(4) AND c(4)< 5 AND txt$(14)= "") THEN
  1396.   Get.String txt$(14),my_gads&(gid)
  1397.   IF txt$(14)<> "" THEN
  1398.    shi2$(c(5))= txt$(14)+CHR$(0) :c(26)= 2 :txt$(13)= txt$(14)
  1399.    junk&= ActivateGadget&(my_gads&(gid),act.win&,0&)
  1400.   END IF
  1401.  END IF
  1402. END IF
  1403. END SUB
  1404.  
  1405. SUB Fill.Area(BYVAL rect)
  1406. SetAPen rport&,3
  1407. SELECT CASE rect
  1408. =5 :file.size= 500 :x&= c(0) :y&= c(1)
  1409. =6 :file.size= 750 :x&= c(0) :y&= c(2)
  1410. END SELECT :dt= file.size\c(3)
  1411. FOR i= 0 TO c(3)
  1412.  Delay dt :INCR x& :RectFill rport&,x&+1,y&,x&+1,y&+8
  1413. NEXT
  1414. IF rect= 5 THEN
  1415.  x&= c(0) :y&= c(1)-1 :x1&= c(0)+300 :y1&= y&+12
  1416.  SetAPen rport&,0 :RectFill rport&,x&,y&,x1&,y1&
  1417. END IF
  1418. END SUB
  1419.  
  1420. SUB Get.String (txt$,BYVAL stgad&)
  1421. STATIC stgad&
  1422. txt$= PEEK$(PEEKL(PEEKL(stgad&+GadgetSpecialInfo)+StringInfoBuffer))
  1423. END SUB
  1424.  
  1425. SUB Input.1 (my_gads&(),BYVAL code)
  1426. IF gid< 6 THEN
  1427.  Set.Attribute GTST_String&,SADD(""+CHR$(0)),my_gads&(6)
  1428.  Set.Attribute GTTX_Text&,SADD(""+CHR$(0)),my_gads&(7)
  1429. END IF
  1430. Get.String txt$(gid),my_gads&(gid) :txt$(14)= txt$(gid) :SOUND 1400,3,85,1
  1431. IF code= 9 THEN
  1432.  t$= txt$(gid)+" " :EXIT SUB
  1433. ELSEIF code<> 9 THEN
  1434.  IF t$<> "" THEN
  1435.   txt$(14)= t$+txt$(14) :t$= ""
  1436.   Set.Attribute GTST_String&,SADD(""+CHR$(0)),my_gads&(4)
  1437.  END IF
  1438.  Set.Attribute GTST_String&,SADD(""+CHR$(0)),my_gads&(gid)
  1439.  Set.Attribute GTTX_Text&,SADD(""+CHR$(0)),my_gads&(7)
  1440.  Set.Attribute GTST_String&,SADD(txt$(14)+CHR$(0)),my_gads&(6)
  1441.  SOUND 1400,3,85,1
  1442. END IF
  1443. IF gid= 6 THEN
  1444.  Set.Attribute GTTX_Text&,SADD(txt$(gid)+CHR$(0)),my_gads&(7)
  1445.  SOUND 1400,3,85,1
  1446.  Set.Attribute GTST_String&,SADD(""+CHR$(0)),my_gads&(6)
  1447. END IF
  1448. END SUB
  1449.  
  1450. SUB Integer.Kind (my_gads&())
  1451. SHARED c&()
  1452. '----------
  1453. Set.Attribute GTNM_Number&,c&(gid),my_gads&(6)
  1454. SELECT CASE gid
  1455. =2,3 :Set.Attribute GA_Disabled&,TRUE&,my_gads&(gid)
  1456. =4 :junk&= ActivateGadget&(my_gads&(5),act.win&,0&) :EXIT SUB
  1457. =5 :op= c(1)
  1458.  SELECT CASE op
  1459.  =0 :c&= (c&(4)+c&(5))
  1460.  =1 :c&= (c&(4)-c&(5))
  1461.  =2 :c&= (c&(4)*c&(5))
  1462.  =3 :c&= (c&(4)/c&(5))
  1463.  END SELECT
  1464.  Set.Attribute GTNM_Number&,c&,my_gads&(7) :SOUND 1400,3,85,1
  1465. END SELECT
  1466. END SUB
  1467.  
  1468. SUB Palette.Kind (BYVAL code)
  1469. c(gid)= code
  1470. SELECT CASE code
  1471. =0 :txt$(14)= "Gray"
  1472. =1 :txt$(14)= "Black"
  1473. =2 :txt$(14)= "White"
  1474. =3 :txt$(14)= "Blue"
  1475. END SELECT :c(26)= 1
  1476. IF gid<> 2 AND gid<> 6 THEN txt$(14)= "    "
  1477. END SUB
  1478.  
  1479. SUB Result.Selected (my_gads&())
  1480. STATIC tgad
  1481. '-----
  1482. IF txt$(13)<> "" THEN
  1483.  txt$(13)= "" :SetAPen rport&,0 :RectFill rport&,111&,136&,355&,146&
  1484. END IF
  1485. IF LEFT$(txt$(14),1)= "_" THEN
  1486.  txt$(14)= MID$(txt$(14),2)
  1487. ELSEIF txt$(14)= "" AND c(26)= 1 THEN
  1488.  Prin.T "Enter another item if you wish",100,0,144 :c(26)= 0
  1489. ELSEIF RIGHT$(txt$(14),1)= CHR$(0) THEN
  1490.  txt$(14)= LEFT$(txt$(14),LEN(txt$(14))-1)
  1491. END IF
  1492. '-----
  1493. my.gads= UBOUND(my_gads&,1)
  1494. rawKey= PEEK(&HBFEC01)
  1495. tgad= my.gads-1
  1496. IF rawKey= 119 THEN
  1497.  tgad= my.gads
  1498.  IF c(26)= 2 THEN tgad= my.gads-2 :c(26)= 0
  1499. END IF 
  1500. IF c(26)= 1 THEN tgad= my.gads :c(26)= 0
  1501. '-----
  1502. Set.Attribute GTTX_Text&,SADD(""+CHR$(0)),my_gads&(my.gads)
  1503. IF my.gads<> 4 THEN
  1504.  Set.Attribute GTTX_Text&,SADD(""+CHR$(0)),my_gads&(my.gads-1)
  1505. END IF
  1506. '-----
  1507. IF rawKey<> 119 AND c(26)= 3 THEN c(26)= 0 :EXIT SUB
  1508. Set.Attribute GTTX_Text&,SADD(txt$(14)+CHR$(0)),my_gads&(tgad)
  1509. IF label$(tgad)= "Selected:" AND txt$(14)<> "" THEN SOUND 1400,3,85,1
  1510. END SUB
  1511.  
  1512. SUB Set.Attribute (BYVAL item&,BYVAL value&,BYVAL gadget&)
  1513. TAGLIST VARPTR(TempTags&(0)),item&,value&,TAG_DONE&
  1514. GT_SetGadgetAttrsA gadget&,act.win&,0&,VARPTR(TempTags&(0))
  1515. END SUB
  1516.  
  1517. SUB Set.Palettes (BYVAL which)
  1518. STATIC i,j,kolor,setpal,wbc()
  1519. STATIC color.map&,view.port&
  1520. '----------------
  1521. view.port&= ViewPortAddress&(act.win&)
  1522. color.map&= PEEKL(view.port&+4)
  1523. '----------------
  1524. SELECT CASE which
  1525. =0 :'Get original palettes
  1526.  FOR i= 0 TO 3 :wbc(i)= GetRGB4&(color.map&,i) :NEXT
  1527.  FOR i=0 TO 3 :wbc$(i)= HEX$(wbc(i)) :NEXT
  1528.  c= -1 :IF LEN(wbc$(i))= 1 AND wbc$(i)= "0" THEN wbc$(i)= "000"
  1529.  FOR i= 0 TO 3
  1530.   FOR j= 1 TO 3 :INCR c :p(c)= VAL("&H"+MID$(wbc$(i),j,1)) :NEXT
  1531.  NEXT
  1532. =1 :kolor= p(12)
  1533.  SELECT CASE kolor
  1534.  =0 :SetRGB4 view.port&,0&,p(0),p(1),p(2)
  1535.  =1 :SetRGB4 view.port&,1&,p(3),p(4),p(5)
  1536.  =2 :SetRGB4 view.port&,2&,p(6),p(7),p(8)
  1537.  =3 :SetRGB4 view.port&,3&,p(9),p(10),p(11)
  1538.  END SELECT :setpal= -1
  1539. =2 :'Restore original palettes
  1540.  c= -1 :IF LEN(wbc$(i))= 1 AND wbc$(i)= "0" THEN wbc$(i)= "000"
  1541.  FOR i= 0 TO 3
  1542.   FOR j= 1 TO 3 :INCR c :p(c)= VAL("&H"+MID$(wbc$(i),j,1)) :NEXT
  1543.  NEXT
  1544.  SetRGB4 view.port&,0&,p(0),p(1),p(2)
  1545.  SetRGB4 view.port&,1&,p(3),p(4),p(5)
  1546.  SetRGB4 view.port&,2&,p(6),p(7),p(8)
  1547.  SetRGB4 view.port&,3&,p(9),p(10),p(11)
  1548. END SELECT
  1549. END SUB
  1550.  
  1551. SUB Slider.Kind (BYVAL code)
  1552. c(gid)= code :txt$(13)= "" :txt$(14)= STR$(code)
  1553. IF gid= 2 OR gid= 3 OR gid= 8 OR gid= 9 THEN c(26)= 0 ELSE c(26)= 3
  1554. END SUB
  1555.  
  1556. '''''''''''''''''''''
  1557. 'UTILITY SUB PROGRAMS
  1558. '''''''''''''''''''''
  1559. SUB Add1.IDCMPFlags
  1560. junk&= ModifyIDCMP& (act.win&, _
  1561.     IDCMP_GADGETUP&+ _
  1562.  IDCMP_REFRESHWINDOW&+ _
  1563.  IDCMP_RAWKEY&+ _
  1564.  IDCMP_VANILLAKEY&)
  1565. END SUB
  1566.  
  1567. SUB Add2.IDCMPFlags
  1568. junk&= ModifyIDCMP& (act.win&, _
  1569.  IDCMP_REFRESHWINDOW&+ _
  1570.  IDCMP_MOUSEBUTTONS&+ _
  1571.     IDCMP_MOUSEMOVE&+ _
  1572.     IDCMP_GADGETDOWN&+ _
  1573.     IDCMP_GADGETUP&+ _
  1574.  IDCMP_MENUPICK&+ _
  1575.  IDCMP_CLOSEWINDOW&+ _
  1576.  IDCMP_RAWKEY&+ _
  1577.  IDCMP_VANILLAKEY&+ _
  1578.     IDCMP_INTUITICKS&)
  1579. END SUB
  1580.  
  1581. SUB Busy.Pointer
  1582. STATIC x
  1583. '-------
  1584. Dos.Script ":HB2Gads/lacepointer"
  1585. '-------
  1586. b.ptr&= AllocRaster& (16&,34&)
  1587. RESTORE Busy_Pointer
  1588. FOR x= 0 TO 64 STEP 4
  1589.  READ d1,d2
  1590.  POKEW b.ptr&+x,d1
  1591.  POKEW b.ptr&+2+x,d2
  1592. NEXT
  1593. SetPointer WINDOW(7),b.ptr&,15&,15&,-7&,-7&
  1594. act.win&= WINDOW(7)
  1595. rport&= WINDOW(8)
  1596. EXIT SUB
  1597. '-------
  1598. Busy_Pointer:
  1599. DATA 0,0
  1600. DATA &H400,&H7C0
  1601. DATA &H0,&H7C0
  1602. DATA &H100,&H380
  1603. DATA &H0,&H7E0
  1604. DATA &H7C0,&H1FF8
  1605. DATA &H1FF0,&H3FEC
  1606. DATA &H3FF8,&H7FDE
  1607. DATA &H3FF8,&H07FBE
  1608. DATA &H7FFC,&HFF7F
  1609. DATA &H7EFC,&HFFFF
  1610. DATA &H7FFC,&HFFFF
  1611. DATA &H3FF8,&H7FFE
  1612. DATA &H3FF8,&H7FFE
  1613. DATA &H1FF0,&H3FFC
  1614. DATA &H7C0,&H1FF8
  1615. DATA &H0,&H7E0
  1616. DATA 0,0
  1617. END SUB
  1618.  
  1619. SUB Dos.Script (file$)
  1620. SHARED nil_handle&
  1621. junk& = Execute&(SADD(file$+CHR$(0)),0&,nil_handle&)
  1622. END SUB
  1623.  
  1624. SUB Error.Trap (BYVAL et)
  1625. WINDOW 1 :CLS :BEEP
  1626. SELECT CASE et
  1627. =1 :txt$= "COULD NOT LOCK PUBLIC SCREEN"
  1628. =2 :txt$= "GetVisualInfo FAILED"
  1629. =3 :txt$= "FAILED TO OPEN Topaz 80"
  1630. =4 :txt$= "CREATE GADGET FAILED" :et= 4
  1631. =5 :txt$= "CREATE GADGET FAILED" :et= 0
  1632. =6 :txt$= "OUT OF MEMORY" :et= 0
  1633. =7 :txt$= "FAILED TO OPEN WINDOW" :et= 0
  1634. END SELECT
  1635. y= (80-LEN(txt$))\2
  1636. LOCATE 12,y :PRINT txt$
  1637. LOCATE 22,23
  1638. PRINT "PRESS ANY KEY TO CLOSE THE PROGRAM"
  1639. SLEEP :CLS
  1640. Close.Program et
  1641. END SUB
  1642.  
  1643. SUB Print.Notes (BYVAL which)
  1644. SELECT CASE which
  1645. =0 :Prin.T "A: Cycle Gadget. B: Mutually Exclusive Gadget.",100,0,18
  1646.  Prin.T "C: String-ExitHelp Gadget (Press the HELP key).",100,0,28
  1647.  Prin.T "D: String-ExitHelp Gadget with input.",100,0,38
  1648.  Prin.T "Select and press RETURN.",100,0,48
  1649.  Prin.T "A",200,77,84  :Prin.T "B",200,389,84
  1650.  Prin.T "C",200,77,100 :Prin.T "D",200,77,116
  1651. =1 :Bevel.Boxes 1
  1652.  Prin.T "Select a color and change its palette.",100,0,18
  1653. =2 :Prin.T "'Click Here' to scroll the text in the borderless Text-",100,0,16
  1654.  Prin.T "Display Gadget. Use the slider to change the speed,",100,0,26
  1655.  Prin.T " 'Pause' to pause and re-start, 'Stop' to stop.",100,0,36
  1656. =3 :Bevel.Boxes 3
  1657.  Prin.T "Editable String-Gadgets. Select and edit if needed,",100,0,24
  1658.  Prin.T "or simply select. Press RETURN.",100,0,34
  1659. =33 :Bevel.Boxes 3 :Prin.T "Text Display Gadgets with border.",100,0,29
  1660. =4 :Bevel.Boxes 3
  1661.  Prin.T "Disabled String-Gadgets. On selecting 'OK', they will",100,0,24
  1662.  Prin.T "be successively enabled and activated for input.",100,0,34
  1663. =44 :Bevel.Boxes 3
  1664.  Prin.T "Text Display Gadgets without border.",100,0,29
  1665. =5 :Prin.T "Click on Gadget or press the",100,0,12
  1666.  Prin.T "underlined KEY ± SHIFT to make selection.",100,0,22
  1667.  Prin.T "Press RETURN to select.",100,0,32
  1668. =6 :Bevel.Boxes 8
  1669.  Prin.T "The actions of the horizontal and vertical gadgets",100,0,18
  1670.  Prin.T "are not coordinated.",100,0,28
  1671. =7 :Prin.T "Various Types of Palette Gadgets.",100,0,18
  1672. =8 : Prin.T "Input2: string center. Input4: string right.",100,0,16
  1673.  Prin.T "Input3&4: Tab Cycle. Input3: also Replace Mode",100,0,26
  1674.  Prin.T "(use pointer/arrows to select&replace a character).",100,0,36
  1675.  Prin.T "Edit: Edit Gadget. Result: Text Display Gadget.",100,0,46
  1676. =9 :Prin.T "Read-only Gadgets.",100,0,18
  1677. =10:Prin.T "Listview Gadget with Editable Display Gadget.",100,0,24
  1678.  Prin.T "Edit the selected item and press RETURN.",100,0,36
  1679. =11 :Prin.T "Listview Gadgets with attached Display Gadget",100,0,24
  1680.  Prin.T "for the Selected Item.",100,0,34
  1681. =12 :Prin.T "Simple Listview Gadgets.",100,0,24
  1682.  Prin.T "Select by clicking on desired item.",100,0,34
  1683. =15 :Bevel.Boxes 16 :Prin.T "Loader",100,58,118
  1684.  Prin.T "Percent",100,50,134 :Prin.T "0",100,117,146
  1685.  Prin.T "50",100,244,146 :Prin.T "100",100,388,146
  1686.  Prin.T "Loader and Percent will activate the respective Progress",100,0,18
  1687.  Prin.T "Indicator. High, Medium and Low will produce a sound of",100,0,28
  1688.  Prin.T "corresponding frequency. Select % and then a sound button.",100,0,38
  1689. =16:Prin.T "Int1-Int4: Number Entry Gadgets. Input-Result: Numeric",100,0,18
  1690.  Prin.T "Display Gadgets with and without border. Int1-Int2 are",100,0,28
  1691.  Prin.T "disabled after an entry. Int2: input from the right.",100,0,38
  1692.  Prin.T "Int3 & Int4 TAB Cycle: make an entry in them,",100,0,48
  1693.  Prin.T "choose an operator and see the Result.",100,0,58
  1694. END SELECT
  1695. END SUB
  1696.  
  1697. SUB Prin.T (txt$,BYVAL style,BYVAL x&,BYVAL y&)
  1698. STATIC apen,bpen,lt
  1699. '------------------
  1700. apen= style\100 :bpen= style MOD 100 :style= bpen MOD 10 :bpen= bpen\10
  1701. lt= LEN(txt$)*8 :IF x&= 0 THEN x&= (PEEKW(act.win&+8)-lt)\2
  1702. '------------------
  1703. SetAPen rport&,apen :SetBPen rport&,bpen
  1704. style&= SetSoftStyle&(rport&,style,255)
  1705. Move rport&,x&,y&
  1706. Text rport&,SADD(txt$),LEN(txt$)
  1707. newstyle&= SetSoftStyle&(rport&,0&,255)
  1708. END SUB
  1709. '''''''''''''''''''''''''''''''''''''''
  1710.